VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cPerfCounter"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Attribute VB_Description = "VB class implementation of Win32 Performance Counter\r\n - 1998 Thomas J. Esh"
'   cPerfCounter class
'VB class implementation of Win32 Performance Counter
' - 1998 Thomas J. Esh

'Note: The Performance Counter is available on most, if not all, Pentium
'systems. Always check the Available property after initializing the class
'to avoid erroneous results. The Elapsed property will be (-1) if no Perf
'Counter is available.
'==================================================

Option Explicit

'======== Win32 API Declarations =========================
Private Type LARGE_INTEGER
    lowpart As Long ' really a 'C' unsigned DWORD / ULONG type
    highpart As Long 'same as VB Long (signed)
End Type

Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long
Attribute QueryPerformanceCounter.VB_Description = "[Private class function]"
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long
Attribute QueryPerformanceFrequency.VB_Description = "[Private class function]"


'========= Private class variables ===============
Dim bAvailable As Boolean 'Available property stash
Dim dPCfreq As Double 'Frequency property stash
Dim liPCstart As LARGE_INTEGER 'start reference (set by Reset method)

'========== Public Class Properties =============================

Property Get Available() As Boolean
Attribute Available.VB_Description = "True if system has Performance Counter. [Read-Only]"
    'True if system has Performance Counter.
    Available = bAvailable
End Property

Property Get Frequency() As Double
Attribute Frequency.VB_Description = "Returns Performance Counter ticks/second. (Note: Resolution = 1/frequency)\r\n[Read-Only]"
    'Returns Performance Counter ticks/second. (Note: Resolution = 1/frequency)
    Frequency = dPCfreq
End Property


'========== Public Class Methods ===============================

Public Sub Reset()
Attribute Reset.VB_Description = "Establishes a ""start time"" reference.\r\nCall at beginning of event / code to be measured."
    'Establishes a "start time" reference.
    'Call at beginning of event / code to be measured.
    Call QueryPerformanceCounter(liPCstart)
End Sub

Public Function Elapsed() As Double
Attribute Elapsed.VB_Description = "Returns elapsed time (sec) since last Reset.\r\n(-1) if error or no counter available on system."
    'Returns elapsed time (sec) since last Reset,
    'or (-1) if error or no counter available on system.
    Dim lRet As Long, liEnd As LARGE_INTEGER
    
    lRet = QueryPerformanceCounter(liEnd)
    If (lRet <> 0&) And (bAvailable = True) Then
        Elapsed = (LargeIntToDbl(liEnd) - LargeIntToDbl(liPCstart)) / dPCfreq
    Else
        Elapsed = -1# 'indicate error
    End If
End Function


'========== Private Class Procedures ==============================

Private Function LargeIntToDbl(LI As LARGE_INTEGER) As Double
Attribute LargeIntToDbl.VB_Description = "[Private class function]"
    'converts a LARGE_INTEGER type to a vb Double
    LargeIntToDbl = CDbl(LI.highpart * &HFFFF) + LongToUDbl(LI.lowpart)
End Function

Private Function LongToUDbl(Lnum As Long) As Double
Attribute LongToUDbl.VB_Description = "[Private class function]"
    'Returns positive vb Double value for 'C' DWORD, ULONG
    'unsigned 32-bit types stored in vb Long.
    If Lnum < 0& Then 'convert to positive Double in range 2,147,483,648 to 4,294,967,295.
        LongToUDbl = 4294967296# + CDbl(Lnum)
    Else
        LongToUDbl = CDbl(Lnum) 'Ok - return input
    End If
End Function

Private Sub Class_Initialize()
    Dim lRet As Long, liFreq As LARGE_INTEGER
    'Determine if system has Performance Counter and get its frequency.
    lRet = QueryPerformanceFrequency(liFreq)
    If lRet <> 0& Then 'counter is available
        bAvailable = True 'set Available property
        dPCfreq = LargeIntToDbl(liFreq) 'set Frequency property
    End If
End Sub
